perm filename MATCH.LSP[C,JRA] blob sn#020490 filedate 1973-01-10 generic text, type T, neo UTF8
(GLOBAL
   (FUNCTIONS MATCH ASSIGNED?)
   (RESERVED /!> /!< /!/' /!? /!/; /!/,))

(DECLARE (SYMBOLS T) (GENPREFIX '\M) (GENSYM 'M)
	 (SPECIAL MALIST MALIST1 MALIST2 MALISTV1 MALISTV2 NOBIND VALV)
         (*LEXPR MATCH TRYASSIGN RVALUE VLOC)
         (*FEXPR CERR))

(DEFUN MATCH N
   ((LAMBDA (VARPAT DATAPAT)
       (PROG (MALIST1 MALIST2 MALISTV1 MALISTV2 NOBIND)
          (COND ((> N 2)
                 (SETQ MALIST1 (ARG 3) MALIST2 (ARG 4) NOBIND T))   )
          (SETQ MALISTV1 (GET 'MALIST1 'VALUE)
                MALISTV2 (GET 'MALIST2 'VALUE))
          (RETURN (COND ((MATCH1 VARPAT DATAPAT)
                         (LIST MALIST1 MALIST2))   ))   ))
    (ARG 1)
    (ARG 2)   ))

(DECLARE (UNSPECIAL MALIST1 MALIST2))(DEFUN MATCH1 (VARPAT DATAPAT)
   (PROG (ACTOR1 ACTOR2)
      (RETURN
         (COND ((ATOM VARPAT) (MATCH2 DATAPAT VARPAT MALISTV2))
               ((ATOM DATAPAT) (MATCH2 VARPAT DATAPAT MALISTV1))
               ((EQ (SETQ ACTOR2 (CAR DATAPAT)) '/!/'))
               ((MEMQ ACTOR2 '(/!< /!/?))
                (MATCH2 VARPAT (ACTORSUBST DATAPAT (CDR MALISTV2)) MALISTV1))
               ((EQ (SETQ ACTOR1 (CAR VARPAT)) '/!>)
                (/!> (CDR VARPAT) DATAPAT MALISTV1 MALISTV2))
               ((EQ ACTOR1 '/!/?)
                (/!/? (CDR VARPAT) DATAPAT MALISTV1 MALISTV2 T))
               ((EQ ACTOR1 '/!/')
                (MBINDR (CADR VARPAT) (CDDR VARPAT) DATAPAT MALISTV1))
               ((EQ ACTOR1 '/!<)
                (/!< (CADR VARPAT) DATAPAT MALISTV1 MALISTV2))
               ((EQ ACTOR1 '/!/,)
                (COMMA (CDR VARPAT) DATAPAT MALISTV1 MALISTV2))
               ((EQ ACTOR1 '/!/;)
                (/!/; (CDR VARPAT) DATAPAT MALISTV1 MALISTV2 T))
               ((EQ ACTOR2  '/!>)
                (/!/? (CDR DATAPAT) VARPAT MALISTV2 MALISTV1 NIL))
               ((EQ ACTOR2 '/!/;)
                (/!/; (CDR DATAPAT) VARPAT MALISTV2 MALISTV1 NIL))
               ((EQ ACTOR2 '/!/,)
                (COMMA (CDR DATAPAT) VARPAT MALISTV2 MALISTV1))
               ((MATCH1 (CAR VARPAT) (CAR DATAPAT))
                (MATCH1 (CDR VARPAT) (CDR DATAPAT)))   ))   ))

(DECLARE (UNSPECIAL MALISTV2))(DEFUN COMMA (VARSPEC DATAPAT MV1 MV2)
   ((LAMBDA (VAR VALSPEC)
       (COND (VALSPEC
              ((LAMBDA (VAL)
                  (COND ((MATCH2 DATAPAT VAL MV2)
                         (MBINDV VAR VAL MV1))   ))
    ∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈∧␈
                       (CDR MALISTV)))
                    ((ACTOR CAR)
                     (COND (NOBIND (GETSPEC CAR (CADR PAT) (CDR MALISTV)))
                           ((MBINDV (CADR PAT) '*UNASSIGNED MALISTV)
                            (LIST CAR))   ))
                    ((NCONC (FINDVARS CAR MALISTV)
                            (FINDVARS (CDR PAT) MALISTV)))   ))
           (CAR PAT)))   ))


(DEFUN HASMUSTASSIGNS (VARS)
   (DO V VARS (CDR V) (NULL V)
      (AND (MEMQ (CAR V) '(/!> /!/')) (RETURN T))   ))


(DEFUN HASVARS (VARS)
   (DO V VARS (CDR V) (NULL V)
      (AND (CAR V) (RETURN T))   ))


(DEFUN VARSUBST (PAT MALIST)
   (COND ((ATOM PAT) PAT)
         ((ACTOR (CAR PAT))
          (ACTORSUBST PAT MALIST))
         ((CONS (VARSUBST (CAR PAT) MALIST)
                (VARSUBST (CDR PAT) MALIST)))   ))


(DEFUN ACTOR (ATOM)
   (MEMQ ATOM '(/!> /!/? /!/' /!< /!/, /!/;))   )
          

(DEFUN ACTORSUBST (PAT MALIST)
   ((LAMBDA (VAR)
       ((LAMBDA (VAL)
           (COND ((EQ VAL '*UNASSIGNED) PAT) (VAL)   ))
        (/!/,1 VAR)))
    (CADR PAT))   )


(DEFUN GETSPEC (ACTOR VAR MALIST)
   (COND ((EQ (/!/,1 VAR) '*UNASSIGNED)
          (COND (NOBIND (CERR UNASSIGNED VARIABLE IN INSTANCE))
                ((LIST ACTOR))   ))
         ((LIST NIL))   ))(DEFUN MBIND (VAR VAL ALISTV)
   (COND (NOBIND (MSET VAR VAL (CDR ALISTV)))
         ((RPLACD ALISTV (CONS (LIST VAR VAL) (CDR ALISTV))))   ))


(DEFUN MBINDV (VAR VAL ALISTV)
   (COND ((NOT VAR))
         (NOBIND (MSET VAR VAL (CDR ALISTV)))
         ((RPLACD ALISTV (CONS (LIST VAR VAL) (CDR ALISTV))))   ))

(DECLARE (UNSPECIAL NOBIND))


(DEFUN MBINDR (VAR RESTRICTIONS VAL ALISTV)
   (OR (NOT VAR)
       (AND (MBIND VAR VAL ALISTV)
            (SATISFY RESTRICTIONS (CDR ALISTV))))   )


(DEFUN /!/, FEXPR (L) (/!/,1 (CAR L)))


(DEFUN /!/,1 (VAR/ )
   ((LAMBDA (PAIR)
       (COND (PAIR (CADR PAIR)) ((RVALUE VAR/ ))   ))
    (ASSQ VAR/  MALIST))   )


(DEFUN SATISFY (RS MALIST)
   (OR (NULL RS)
       (APPLY 'AND RS))   )

(DECLARE (UNSPECIAL MALIST))


(DEFUN MSET (VAR VAL MALIST)
   ((LAMBDA (PAIR)
       (COND (PAIR (RPLACA (CDR PAIR) VAL) VAL)
             ((CERR VARIABLE @VAR UNBOUND IN MATCH ALIST))   )
       T)
    (ASSQ VAR MALIST))   )


(DEFUN ASSIGNED? (VAR)
   (PROG (VAL)
      (RETURN
         (COND ((SETQ VAL (VLOC VAR)) (NOT (EQ (CADR VAL) '*UNASSIGNED)))
               ((SETQ VAL (BOUNDP VAR)) (NOT (EQ (CDR VAL) '*UNASSIGNED)))   ))   ))